xHVERSION = 3.00)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0 _openaddressdialogPixelsClass9_dialog_openaddressdialog.Top = 10 Left = 310 Name = "oShellExecute" _openaddressdialog oShellExecutecustom _environ.vcx _shellexecute cmdOpenFile _scx2htmlPixels1Classjcsource = coutfile = ngenoutput = 2 lautonameoutput = .T. cscope = cstyle = Name = "_scx2html"  _scx2html1n UU%  Uk!TCC File Name:@%C>B-TU LCURLTHISFORMCFILEEXTTHISPARENTCBOURL DISPLAYVALUECMDOKSETFOCUSClick,1qqAa2)U_openaddressdialog commandbutton commandbutton=PROCEDURE Click thisform.Hide thisform.Release ENDPROC 1_cookiePixelsClass1_custom_cookieFccookie = cookietable = cookies.dbf dbfalias = Name = "_cookie" customPROCEDURE Click LOCAL lcURL lcURL=LOWER(GETFILE(thisform.cFileExt,"File Name:")) IF EMPTY(lcURL) RETURN .F. ENDIF this.parent.cboURL.DisplayValue=lcURL this.parent.cmdOK.SetFocus ENDPROC Top = 86 Left = 256 Height = 23 Width = 75 FontName = "MS Sans Serif" FontSize = 8 Caption = "\=TC %Ccookies rcookiesP%C L#  B U CSTRTHISFIXURLCCOOKIEGETVAL MAKECOOKIECOOKIEDBFALIASCOOKIESRNUM%C F E %C4 Rrcookies%C {>COUTHISCCOOKIECOOKIESCOOKIEDBFALIASRNUM   T C + T  +a%% T C% % C >T   !6%CC \0123456789ABCDEF'T  C =T C \.@T  C =CC0xC \ %C > T C \!T   !T   B UCSTRN1RV  TC  %F BTCC C >\%C ==TC \%&BCC C& = BC UCSTRCVALN1C2%C B-%TCCC_6%C 0 5h1 CIC & Q 1T TCU CCOOKIEDBFTHIS COOKIETABLEC_DEFCOOKIEDBFCOOKIERNUMEXTRACOOKIESDBFALIAS makecookie, getcookieYwritecookieinfofixurlgetvalInit1a3q11qA1qAA31qA1!AA3AqqAAaAAAAqAAA3aAAA!A3s!qAQ!RAQ!2]}!;)?XpJO \) cn%ctUT%CCC0 kTCFRX%C0 gB-T%CCfDBF5%"TCSAFETYvG.%TC]\CCFRX3SET SAFETY &lcSafety T1B-"%CL tTCHTMAG  U LCSOURCELCREPORTLCSAFETYTHISCSOURCELCREATETEMPREPORTLAUTONAMEOUTPUTCOUTFILE NGENOUTPUTCSTYLECSCOPEgenhtml,1!qAAQaQ!qAA#A2)csource This is source file from which to generate HTML. ngenoutput _GENHTML output options. See _GENHTML file header. coutfile This is name of HTM file to output. lusecurrentalias Use current alias as source. lautonameoutput Causes _GENHTML to automatically name the output file based on source. cscope The scope of records to process (e.g., NEXT 1, REST). cstyle The registered style to use for visual display. *genhtml Generates HTML calling _GENHTML engine. o VV;% UB+%CL CC > TC%CT%C0 TCDBF%CC0 B-T"%CL TCHTMAGU LCSOURCETHISLUSECURRENTALIASCSOURCELAUTONAMEOUTPUTCOUTFILE NGENOUTPUTCSTYLECSCOPEgenhtml,1qA!qAAA"A2<)VGPROCEDURE genhtml LOCAL lcSource IF VARTYPE(THIS.lUseCurrentAlias)="L" AND; THIS.lUseCurrentAlias AND !EMPTY(ALIAS()) lcSource=ALIAS() ENDIF IF EMPTY(lcSource) lcSource=this.cSource IF !FILE(lcSource) lcSource = GETFILE("DBF") IF EMPTY(lcSource) OR !FILE(lcSource) RETURN .F. ENDIF ENDIF ENDIF this.cSource=lcSource IF VARTYPE(THIS.lAutoNameOutput)="L" AND; THIS.lAutoNameOutput THIS.cOutFile = FORCEEXT(lcSource,"HTM") ENDIF DO (_GENHTML) WITH (this.cOutFile),(this.cSource),(this.nGenOutput),"",(this.cStyle),(this.cScope) ENDPROC PROCEDURE genhtml LOCAL lcSource,lcReport,lcSafety lcSource = THIS.cSource IF VARTYPE(lcSource)#"C" OR !FILE(lcSource) lcSource = GETFILE("FRX") IF !FILE(lcSource) RETURN .F. ENDIF ENDIF THIS.cSource = lcSource IF UPPER(JUSTEXT(lcSource))="DBF" IF THIS.lCreateTempReport lcSafety = SET("SAFETY") SET SAFETY OFF lcReport = SYS(2023)+"\"+ JUSTFNAME(FORCEEXT(lcSource,"FRX")) CREATE REPORT (lcReport) FROM (lcSource) SET SAFETY &lcSafety THIS.cSource = lcReport ELSE RETURN .F. ENDIF ENDIF IF VARTYPE(THIS.lAutoNameOutput)="L" AND; THIS.lAutoNameOutput THIS.cOutFile = FORCEEXT(lcSource,"HTM") ENDIF DO (_GENHTML) WITH (this.cOutFile),(this.cSource),(this.nGenOutput),"",(this.cStyle),(this.cScope) ENDPROC linitialized Control initialized flag. ldropdown lrequestonenter lmovefocus lgotfocus curl Current URL. curlhistorytable Name of URL history table. lurlhistory Saves URL history. ctempfileprefix lformnavigate ohyperlink chyperlinkclass chyperlinkclasslibrary *openurlhistory *navigate Request document based on URL address. *initialize *validurl *ohyperlink_access  PROCEDURE makecookie RETURN STRTRAN(STRTRAN(TIME()+ PADL(SECONDS(),10,'0'),":",""),".","") ENDPROC PROCEDURE getcookie LPARAMETERS cStr THIS.FixURL(@m.cStr) *Get the cookie value from either a parameter or a *hidden input field IF "Cookie="$ m.cStr THIS.cCookie=THIS.getval(m.cStr,"Cookie") m.cStr = STRTRAN(m.cStr,"&Cookie=") m.cStr = STRTRAN(m.cStr,"Cookie=") ELSE THIS.cCookie= LEFT(m.cStr,LEN(THIS.MakeCookie())) ENDIF cStr = STRTRAN(m.cStr,THIS.cCookie,"") IF !SEEK(THIS.cCookie,"cookies") INSERT INTO cookies (cookie) VALUES (THIS.cCookie) ELSE IF !EMPTY(THIS.dbfAlias) GOTO (cookies.rnum) IN (THIS.dbfAlias) ENDIF ENDIF RETURN m.cstr ENDPROC PROCEDURE writecookieinfo IF !EMPTY(THIS.cCookie) SELECT cookies SEEK THIS.cCookie IF !FOUND() INSERT INTO cookies (cookie) VALUES (THIS.cCookie) ENDIF IF !EMPTY(THIS.dbfAlias) REPLACE rnum WITH RECNO(THIS.dbfAlias) ENDIF ENDIF ENDPROC PROCEDURE fixurl LPARAMETERS m.cStr LOCAL m.n1,m.rv m.cstr=STRTRAN(m.cstr,"+"," ") m.rv = "" DO WHILE .T. IF "%" $ m.cStr m.n1 = AT('%',m.cStr) IF m.n1 > LEN(m.cStr) - 2 m.rv = m.rv + m.cStr EXIT ENDIF IF atc(SUBSTR(m.cStr,m.n1+1,1),"0123456789ABCDEF")=0 && not hex digit m.rv = m.rv + LEFT(m.cStr,m.n1) m.cStr = SUBSTR(m.cStr,m.n1+1) LOOP ENDIF m.rv = m.rv + LEFT(m.cStr,m.n1-1) + ; CHR(EVAL("0x"+SUBSTR(m.cStr,m.n1+1,2))) IF LEN(m.cStr) > m.n1 + 2 m.cStr = SUBSTR(m.cStr,m.n1+3) ELSE EXIT ENDIF ELSE m.rv = m.rv + m.cStr EXIT ENDIF ENDDO m.cStr = m.rv RETURN m.rv ENDPROC PROCEDURE getval LPARAMETERS cstr,cVal LOCAL n1,c2 n1 = AT(m.cVal,m.cStr) IF n1 = 0 return "" ENDIF c2 = ALLTRIM(SUBSTR(m.cStr,n1 + LEN(m.cVal))) IF LEFT(m.c2,1) = '=' c2 = SUBSTR(m.c2,2) ENDIF IF "&"$c2 RETURN ALLTRIM(LEFT(m.c2,AT('&',m.c2)-1)) ELSE RETURN ALLTRIM(m.c2) ENDIF ENDPROC PROCEDURE Init * We could present the user with a Login screen, * and use the username as a key for the cookie. LOCAL cCookieDBF IF EMPTY(THIS.CookieTable) RETURN .F. ENDIF cCookieDBF = IIF(EMPTY(TRAN(THIS.CookieTable)),C_DEFCOOKIEDBF,THIS.CookieTable) IF !FILE(m.cCookieDBF) * a table to store user state based on a cookie (timestamp) CREATE TABLE (m.cCookieDBF) free (cookie c(20), rnum i, extra c(10)) INDEX ON cookie TAG cookie ENDIF USE (m.cCookieDBF) ALIAS cookies ORDER 1 && Reopen shared THIS.CookieTable = m.cCookieDBF THIS.dbfAlias=ALIAS() ENDPROC FontName = "MS Sans Serif" FontSize = 8 ColumnCount = 1 Height = 23 TabIndex = 2 Width = 200 Format = "K" InputMask = (REPLICATE("X",254)) DisplayCount = 16 curl = curlhistorytable = (IIF(VERSION(2)=0,"",HOME())+"URLHstry.dbf") lurlhistory = .T. ctempfileprefix = _temp ohyperlink = .NULL. chyperlinkclass = _HyperLinkBase chyperlinkclasslibrary = _HyperLink.vcx Name = "_urlcombobox"  [%U  % C T%C urlhistoryIQB- TCW%C urlhistoryFTCC@F%CC] Q %C  FB-%CURLNamebMQ %CC]y3h1MTT NQM%C CreateDatebTC LastAccessbT C ExecCountbN Q %C  FB-%C CreateDatebT2Si1T%C LastAccessbTii1T%C ExecCountbNi1 NQ%Cm LASTACCESSG(( LastAccess&  G(C' -U LCFILENAME LNLASTSELECTTHIS LURLHISTORYCURLHISTORYTABLE URLHISTORYURLNAME CREATEDATE LASTACCESS EXECCOUNT %-TCGTCT-%CoB-TCC@)%.CCCC>=@ TB-%C@C@BZ%CC\:8C@Cfile://@C@Chttp://@  IBC% C BL% CthisformbO "CC Navigateh@method BC ULCURLLCTEMPFILEPREFIXTHIS LDROPDOWNVALUE DISPLAYVALUECTEMPFILEPREFIXCURLADDITEM LFORMNAVIGATE OHYPERLINK NAVIGATETOTHISFORMNAVIGATE%BTa%C GFB-%C urlhistoryF ~C?FUTHIS LINITIALIZEDOPENURLHISTORY URLHISTORYADDITEMURLNAME%C& BTC%: CC=@http: CC=@file: CC=@ftp. bCC=@www."CCCR@.com.gov.net &C\: C=\\   Thttp://%CC\:W$TCC\//////<%: C: CC=@ftp. :Tfile://CCC\///////// BUTCURLLCURLQ%CO>&C oHyperLink BUTHIS OHYPERLINK SETOBJECTREFCHYPERLINKCLASSCHYPERLINKCLASSLIBRARY UTHIS INITIALIZETUTHISCURL DISPLAYVALUE(%C urlhistory!QU URLHISTORYT% <  %Ta%z\{TAB};\{Ctrl+A};U LLDROPDOWNTHIS LDROPDOWNLREQUESTONENTER LMOVEFOCUSNAVIGATE%CDB-'%CtnColumnbN sB TCTC TCW TC#3%C\ C/   FB-TCC @)%.CCCC>=@ pT  FB-( %CCC @C@C !CT %C urlhistory  FBF %C+6--CCC@C@ %C4z>=r urlhistory FUTCITEMTNINDEXTNCOLUMNLCITEM LNLASTSELECT LTDATETIMELNCOUNTLNATPOSLCTEMPFILEPREFIXTHISVALIDURLOPENURLHISTORYCTEMPFILEPREFIX DISPLAYVALUE LISTCOUNTLIST REMOVEITEM URLHISTORYURLNAME LASTACCESS EXECCOUNT CREATEDATET-T-%0B%CfTTTTC>UTHIS LDROPDOWN LMOVEFOCUS LGOTFOCUS DISPLAYVALUESELSTART SELLENGTHT-T-UTHIS LGOTFOCUS LDROPDOWNv Ta%  o%aT-\{TAB}; UNKEYCODE NSHIFTALTCTRLTHIS LGOTFOCUSLREQUESTONENTER LDROPDOWNVALIDTaUTHIS LDROPDOWN,%%T-B-UTHIS LMOVEFOCUS%'BTa%QB%CTTTTC>U NBUTTONNSHIFTNXCOORDNYCOORDTHIS LGOTFOCUS SELLENGTH DISPLAYVALUESELSTARTopenurlhistory,navigate initialize^validurlJohyperlink_accessE Refresh ProgrammaticChange Destroy: Validr AddItemY GotFocus" LostFocus KeyPressJDropDownWhen7MouseUpy1AqAqAaqAAAAQ2AqAAQAQAAA1AAA3!!AqAAqAAAAAqAAAAA3AA!qAqAA3qqA AAAA3aA3313A3qA!AA3AqAqAAQ11AqAAAqAAAAQAAAqAAA3AA!QA33AA33qA31AAAAA!QA28 <W,  `g5 ry ~ "@r * ! <z )PROCEDURE openurlhistory LOCAL lcFileName,lnLastSelect IF NOT this.lURLHistory OR EMPTY(this.cURLHistoryTable) IF USED("urlhistory") USE IN urlhistory ENDIF RETURN .F. ENDIF lnLastSelect=SELECT() IF USED("urlhistory") SELECT urlhistory ELSE lcFileName=LOWER(FULLPATH(this.cURLHistoryTable)) SELECT 0 IF NOT EMPTY(SYS(2000,lcFileName)) USE (lcFileName) SHARED ALIAS urlhistory AGAIN IF NOT USED() SELECT (lnLastSelect) RETURN .F. ENDIF IF TYPE("URLName")#"M" USE ERASE (lcFileName) ENDIF ENDIF IF EMPTY(SYS(2000,lcFileName)) CREATE TABLE (lcFileName) ; (URLName M, CreateDate T, LastAccess T, ExecCount N(8)) USE (lcFileName) SHARED ALIAS urlhistory AGAIN ENDIF IF TYPE("CreateDate")#"T" OR TYPE("LastAccess")#"T" OR TYPE("ExecCount")#"N" USE (lcFileName) EXCLUSIVE ALIAS urlhistory IF NOT USED() SELECT (lnLastSelect) RETURN .F. ENDIF IF TYPE("CreateDate")#"T" ZAP ALTER TABLE (lcFileName) ADD COLUMN CreateDate T NULL ENDIF IF TYPE("LastAccess")#"T" ALTER TABLE (lcFileName) ADD COLUMN LastAccess T NULL ENDIF IF TYPE("ExecCount")#"N" ALTER TABLE (lcFileName) ADD COLUMN ExecCount N(8) NULL ENDIF USE (lcFileName) SHARED ALIAS urlhistory AGAIN ENDIF IF KEY(1)=="LASTACCESS" SET ORDER TO LastAccess ELSE INDEX ON LastAccess TAG LastAccess ASCENDING ADDITIVE ENDIF SET FILTER TO NOT DELETED() LOCATE ENDIF ENDPROC PROCEDURE navigate LOCAL lcURL,lcTempFilePrefix IF this.lDropDown lcURL=ALLTRIM(this.Value) ELSE lcURL=ALLTRIM(this.DisplayValue) ENDIF this.lDropDown=.F. IF EMPTY(lcURL) RETURN .F. ENDIF lcTempFilePrefix=LOWER(ALLTRIM(this.cTempFilePrefix)) IF "."$lcURL AND LOWER(LEFT(JUSTFNAME(lcURL),LEN(lcTempFilePrefix)))==lcTempFilePrefix this.DisplayValue=lcURL RETURN .F. ENDIF IF LOWER(lcURL)==LOWER(this.cURL) RETURN ENDIF IF SUBSTR(PADR(lcURL,5),5,1)==":" AND (LOWER(lcURL)==LOWER("file://"+this.cURL) OR ; LOWER(lcURL)==LOWER("http://"+this.cURL)) RETURN ENDIF this.AddItem(lcURL,1,1) IF NOT this.lFormNavigate this.oHyperLink.NavigateTo(lcURL) RETURN ENDIF IF NOT this.lFormNavigate OR TYPE("thisform")#"O" OR ; NOT LOWER(PEMSTATUS(thisform,"Navigate",3))=="method" RETURN ENDIF thisform.Navigate(lcURL) ENDPROC PROCEDURE initialize IF this.lInitialized RETURN ENDIF this.lInitialized=.T. IF NOT this.OpenURLHistory() SELECT 0 RETURN .F. ENDIF IF USED("urlhistory") SELECT urlhistory SCAN ALL this.AddItem(URLName,1,1.1) ENDSCAN ENDIF SELECT 0 ENDPROC PROCEDURE validurl LPARAMETERS tcURL LOCAL lcURL IF EMPTY(tcURL) RETURN "" ENDIF lcURL=ALLTRIM(tcURL) IF NOT ":"$lcURL AND NOT LOWER(LEFT(lcURL,5))=="http:" AND ; NOT LOWER(LEFT(lcURL,5))=="file:" AND ; NOT LOWER(LEFT(lcURL,4))=="ftp." AND (LOWER(LEFT(lcURL,4))=="www." OR ; INLIST(LOWER(RIGHT(lcURL,4)),".com",".gov",".net") OR ; (NOT SUBSTR(lcURL,2,1)==":" AND NOT LEFT(lcURL,2)=="\\")) lcURL="http://"+lcURL ENDIF IF SUBSTR(PADR(lcURL,5),5,1)==":" lcURL=STRTRAN(STRTRAN(lcURl,"\","/"),"///","//") ELSE IF (NOT ":"$lcURL OR AT(":",lcURL)=2) AND NOT LOWER(LEFT(lcURL,4))=="ftp." lcURL="file://"+STRTRAN(STRTRAN(STRTRAN(lcURL,"\","/"),"///","//"),"//","/") ENDIF ENDIF RETURN lcURL ENDPROC PROCEDURE ohyperlink_access IF VARTYPE(this.oHyperlink)#"O" this.SetObjectRef("oHyperLink",this.cHyperLinkClass,this.cHyperLinkClassLibrary) ENDIF RETURN this.oHyperlink ENDPROC PROCEDURE Refresh this.Initialize ENDPROC PROCEDURE ProgrammaticChange this.cURL=this.DisplayValue ENDPROC PROCEDURE Destroy IF USED("urlhistory") USE IN urlhistory ENDIF ENDPROC PROCEDURE Valid LOCAL llDropDown llDropDown=this.lDropDown IF this.lRequestOnEnter AND NOT this.lMoveFocus this.Navigate ENDIF IF llDropDown this.lMoveFocus=.T. IF this.lRequestOnEnter KEYBOARD "{TAB}" PLAIN ELSE KEYBOARD "{Ctrl+A}" PLAIN ENDIF ENDIF ENDPROC PROCEDURE AddItem LPARAMETERS tcItem,tnIndex,tnColumn LOCAL lcItem,lnLastSelect,ltDateTime,lnCount,lnAtPos,lcTempFilePrefix IF EMPTY(tcItem) NODEFAULT RETURN .F. ENDIF IF TYPE("tnColumn")=="N" AND tnColumn#1 RETURN ENDIF ltDateTime=DATETIME() lcItem=this.ValidURL(tcItem) lnLastSelect=SELECT() this.OpenURLHistory lnAtPos=RAT("#",lcItem) IF lnAtPos>0 AND lnAtPos>RAT("\",lcItem) AND lnAtPos>RAT("/",lcItem) NODEFAULT SELECT (lnLastSelect) RETURN .F. ENDIF lcTempFilePrefix=LOWER(ALLTRIM(this.cTempFilePrefix)) IF "."$lcItem AND LOWER(LEFT(JUSTFNAME(lcItem),LEN(lcTempFilePrefix)))==lcTempFilePrefix this.DisplayValue=lcItem NODEFAULT SELECT (lnLastSelect) RETURN .F. ENDIF FOR lnCount = 1 TO this.ListCount IF LOWER(ALLTRIM(this.List[lnCount]))==LOWER(lcItem) this.RemoveItem(lnCount) EXIT ENDIF ENDFOR DODEFAULT(lcItem,tnIndex,tnColumn) NODEFAULT this.DisplayValue=lcItem IF NOT USED("urlhistory") SELECT (lnLastSelect) RETURN ENDIF SELECT urlhistory IF EOF() LOCATE ENDIF LOCATE FOR ALLTRIM(LOWER(MLINE(URLName,1)))==LOWER(lcItem) IF FOUND() REPLACE LastAccess WITH ltDateTime, ExecCount WITH ExecCount+1 ELSE INSERT INTO urlhistory (URLName, CreateDate, LastAccess, ExecCount) ; VALUES (lcItem, ltDateTime, ltDateTime, 1) ENDIF SELECT (lnLastSelect) ENDPROC PROCEDURE GotFocus this.lDropDown=.F. this.lMoveFocus=.F. IF this.lGotFocus RETURN ENDIF IF EMPTY(this.DisplayValue) this.SelStart=0 this.SelLength=0 ELSE this.SelStart=0 this.SelLength=LEN(this.DisplayValue) ENDIF ENDPROC PROCEDURE LostFocus this.lGotFocus=.F. this.lDropDown=.F. ENDPROC PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl this.lGotFocus=.T. IF this.lRequestOnEnter AND nKeyCode=13 IF this.lDropDown this.lDropDown=.F. KEYBOARD "{TAB}" PLAIN ENDIF this.Valid ENDIF ENDPROC PROCEDURE DropDown this.lDropDown=.T. ENDPROC PROCEDURE When IF this.lMoveFocus this.lMoveFocus=.F. RETURN .F. ENDIF ENDPROC PROCEDURE MouseUp LPARAMETERS nButton, nShift, nXCoord, nYCoord IF this.lGotFocus RETURN ENDIF this.lGotFocus=.T. IF this.SelLength>0 RETURN ENDIF IF EMPTY(this.DisplayValue) this.SelStart=0 this.SelLength=0 ELSE this.SelStart=0 this.SelLength=LEN(this.DisplayValue) ENDIF ENDPROC